HPAVC/HPAVC CD-ROM.iso/pc/PRUS101.ZIP/FFILES.INC

Text File | 1994-12-19 | 8.2 KB | 265 lines

{ FFILES.INC - include file for the PRUSSG unit FDOS to speed up and enhance
  file related operations under DOS / implementation part }
 (***************************************************************************

         RELEASE 1.01 - as first contained in the file PRUS101.LZH
                by Peter Schuette, 2:2452/117.19, GERMANY

               --------------------------------------------
                organized for Fido's PASCAL related echoes
               --------------------------------------------

     08/12/1994 to 09/05/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
     09/06/1994 to --/--/---- by Peter Schuette,   2:2452/117.19, GERMANY


           As far as third party copyrights are not violated this
           source code is hereby placed to the public domain. Use
           it whatever way you want, but use AT YOUR OWN RISK.

           In case you should modify the source rather send your
           modifications to the unit's current organizer (see above for
           NM address) than to spread it on your own. This will help to
           keep the unit updated and grant a certain standard to all
           other users as well.

           The unit is currently still under work. So it might greatly
           benefit of your participation.

           Those who contributed to the following piece of source,
           listed in alphabethical order:
        ================================================================
           Orazio Czerwenka, Horst Kraemer, Wilbert van Leijen,
           Sieghard Schicktanz, Peter Schuette ...
        ================================================================
           YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.

           Credits in your own programs are as welcome as unnecessary.

 ***************************************************************************)

{ ----- VARs and CONSTs for FILEONPATH ------------------------------------- }

VAR
  searchCOM: boolean;
  DirEntry: SearchRec;
  SearchName: PathStr;
  SearchPath: DirStr;
  DOSpath: string;

CONST
  foundPrevious: boolean = false;
  ProgExt: ARRAY [boolean] OF ExtStr = ('.EXE', '.COM');

{ -------------------------------------------------------------------------- }

function FileExists(FileName:PathStr):boolean;
{ Original author: Wilbert van Leijen,
  modified according to proposals
  of Horst Kraemer }
begin
  FileName[Length(FileName)+1]:=#0;
  { the compiler adds #0 faster than BASM does,
    have a look on your debugger; Horst Kraemer }
  asm
    push ds
    push ss
    pop  ds
    lea  dx,filename[1]
    mov  ax,4300h
    int  21h
    mov  @result,false
    jc   @1
    inc  @result
@1: pop  ds
  end
end;

{ -------------------------------------------------------------------------- }

FUNCTION FirstFile (SearchPath: PathStr): boolean;
 BEGIN (* FirstFile *)
   FindFirst (SearchPath, SearchFileAttr, DirEntry);
   FirstFile:= DosError = 0;
 END (* FirstFile *);

FUNCTION anotherFile: boolean;
 BEGIN (* anotherFile *)
   FindNext (DirEntry);
   anotherFile:= DosError = 0;
 END (* anotherFile *);


FUNCTION nextDir (VAR DOSpath: string): DirStr;
 VAR
   sc: byte;
 BEGIN (* nextDir *)
   sc:= Pos (';', DOSpath);
   IF sc <> 0 THEN BEGIN
     nextDir:= FExpand (Copy (DOSpath, 1, pred (sc)));
     Delete (DOSpath, 1, sc);
   END (* IF sc <> 0 *)
   ELSE BEGIN
     nextDir:= FExpand (DOSpath);
     DOSpath:= '';
   END (* ELSE *);
 END (* nextDir *);

FUNCTION FileOnPath (FileSpec: PathStr; PathVariable: String;
   prime: boolean): PathStr;
 VAR
   Ext: ExtStr;

 PROCEDURE getDOSpath;
  BEGIN (* getDOSpath *)
    IF PathVariable = '' THEN PathVariable:= 'PATH';
    DOSpath:= GetEnv (PathVariable);
    SearchPath:= FExpand ('.');
    SearchPath:= EnsureBackslash (SearchPath);
  END (* getDOSpath *);


 PROCEDURE searchDOSpath;
  BEGIN (* searchDOSpath *)

    REPEAT (* UNTIL prime *)

      IF (NOT searchCOM) AND (DOSpath = '') THEN BEGIN
 IF anotherFile
   THEN FileOnPath:= SearchPath+ DirEntry.Name
   ELSE BEGIN
     FileOnPath:= ''; foundPrevious:= false;
   END (* ELSE *);
   prime:= true;
      END (* IF NOT searchCOM AND (DOSpath = '') *)
      ELSE BEGIN

 SearchPath:= nextDir (DOSpath);
 SearchPath:= EnsureBackslash (SearchPath);
 prime:= FirstFile (SearchPath+ SearchName);

 IF prime
   THEN FileOnPath:= SearchPath+ DirEntry.Name
   ELSE IF searchCOM AND (DOSpath = '') THEN BEGIN
     searchCOM:= false;
     SearchName:= Copy (SearchName, 1, Length (SearchName)- 4)+
    ProgExt [false];
     getDOSpath;
     prime:= FirstFile (SearchPath+ SearchName);
     IF prime THEN FileOnPath:= SearchPath+ DirEntry.Name;
   END (* IF searchCOM AND (DOSpath = '') *);
 END (* ELSE *);
    UNTIL prime;
  END (* searchDOSpath *);


 BEGIN (* FileOnPath *)
   IF prime THEN foundPrevious:= false;

   IF foundPrevious THEN BEGIN

     IF anotherFile THEN BEGIN
       FileOnPath:= SearchPath+ DirEntry.Name;
     END (* IF anotherFile *)
     ELSE searchDOSpath;

   END (* IF foundPrevious *)
   ELSE BEGIN
     {$V-}
     FSplit (FileSpec, SearchPath, SearchName, Ext);
     {$V+}
     IF SearchName = '' THEN SearchName:= '*';
     IF Ext = '' THEN BEGIN
       searchCOM:= true;
       Ext:= ProgExt [true];
     END (* IF Ext = '' *);
     SearchName:= SearchName+ Ext;

     IF SearchPath = ''
       THEN getDOSpath
       ELSE BEGIN
  SearchPath:= FExpand (SearchPath);
  DOSpath:= '';
       END (* ELSE *);

     foundPrevious:= true;

     IF FirstFile (SearchPath+ SearchName)
       THEN FileOnPath:= SearchPath+ DirEntry.Name
       ELSE searchDOSpath;

   END (* ELSE *);
 END (* FileOnPath *);

{ -------------------------------------------------------------------------- }

Function DelFile;
{ Mailed in by Peter Schuette }
VAr R: Registers;
Begin {DelFile}

  {append #0 to filename to make it ASCIIZ}
  FileName[Length(FileName)+1] := #0;

  R.AH := $41;
  R.DS := Seg(FileName);
  R.DX := Ofs(FileName)+1;

  Intr($21, R);

  If (R.Flags and FCarry) <> 0 Then DelFile := R.AX
  Else DelFile := 0;
End; {DelFile}

{ -------------------------------------------------------------------------- }

function RenFile;
{ Mailed in by Peter Schuette }
Var R: Registers;
Begin {RenFile}
  OldName[Length(OldName)+1] := #0;
  NewName[Length(NewName)+1] := #0;

  R.AH := $56;
  R.DS := Seg(OldName);
  R.DX := Ofs(OldName)+1;

  R.ES := Seg(NewName);
  R.DI := Ofs(NewName)+1;

  Intr($21, R);

  If (R.Flags and FCarry) <> 0 Then RenFile := R.AX
  Else RenFile := 0;
End; {RenFile}

{ --------------------------------------------------------------------------

 Änderungen:
 ===========
 in 1.00:
 --------
12.08.1994 -ocz FileExist, RenFile und DelFile aus FDOS in FFILES
                ausgelagert.
           -ocz FileExist umbenannt in FileExists (=Korrektur eines
                Tipfehlers :->).
           -ocz *** NEU! *** Sieghard Schicktanzs OnPath als FileOnPath
                aufgenommen.
                Typendeklaration VarString = string[20] aufgegeben, da die
                Umgebungsvariable PATH ab DOS 5.0 mit Tricks die doppelte
                Länge eines ComStr annehmen können soll. Das wären
                (theoretisch) bis zu 2x127 = 254 Zeichen. Den Typen VarString
                also der Einfachheit halber durch den vordefinierten Typen
                String ersetzt.
                FileOnPath's FileExists umbenannt in FirstFile. Es kann nicht
                durch die bereits vorhandene ASM-Variante ersetzt werden, da
                es den von FileOnPath benötigten SearchRec mittels FindFirst
                initialisieren muß, damit die Routine funktioniert.
                Die Konstante DataFiles wurde zur flexibleren Handhabung im
                Interface-Teil über FFILES.DEC als typisierte Konstante
                SearchFileAttr exportiert.
                Die Prozedur w_Backslash wurde zur Vermeidung doppelter
                Routinen in den Projekt-Units durch die Funktion EnsureBack-
                Slash aus FSTR ersetzt.

  -------------------------------------------------------------------------- }